home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0145_Status Bar Component.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-30  |  7.7 KB  |  261 lines

  1. {
  2.  Author:    Craig Ward
  3.  Copyright: none - public domain
  4.  
  5.  Date:      20/5/96
  6.  
  7.  Version:   1.0
  8.  
  9.  Overview:  Status bar
  10.  
  11.  Notes:     The captions for each panel (stored within the wrapper component),
  12.             can be accessed via their index. The indices are:
  13.              [0] status panel
  14.              [1] caps-lock panel
  15.              [2] num-lock panel
  16.              [3] scroll-lock panel
  17.              [4] time panel
  18.  
  19.             The component will automatically check for the state of the caps-lock,
  20.             num-lock, and scroll-lock keys, plus, it will also display the current
  21.             time (all achieved through a private TTimer). Furthermore, the
  22.             component will also automatically display any application hint, by
  23.             setting the application's OnHint method to the custom method that
  24.             is used by the TTimer.
  25. *******************************************************************************}
  26. unit Cwstatus;
  27.  
  28. interface
  29.  
  30. uses
  31.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  32.   Forms, Dialogs, ExtCtrls;
  33.  
  34. type
  35.  
  36.   {container object for panels}
  37.   TStatusPanel = class(TPanel)
  38.   private
  39.     { Private declarations }
  40.     FStatusPanel: TPanel;            {the comment panel}
  41.     FCapsPanel: TPanel;              {the caps-lock panel}
  42.     FNumPanel: TPanel;               {the num-lock panel}
  43.     FScrollPanel: TPanel;            {the scroll-lock panel}
  44.     FTimePanel: TPanel;              {the time panel}
  45.   public
  46.     { Public declarations }
  47.     constructor Create(AOwner: TComponent); override;
  48.   end;
  49.  
  50.   {wrapper for component}
  51.   TcwStatusBar = Class(TWinControl)
  52.     StatusPanel: TStatusPanel;
  53.     FTimer: TTimer;
  54.   private
  55.     function GetCaption(Index: Integer): string;
  56.     procedure SetCaption(Index: Integer; Cap: string);
  57.     procedure mTimer(sender: TObject);
  58.   public
  59.     constructor Create(AOwner: TComponent); override;
  60.     destructor Destroy; override;
  61.     property Captions[Index: Integer]: string read GetCaption write SetCaption;
  62.   published
  63.     property Font;
  64.     property ParentFont;
  65.     property Align;
  66.   end;
  67.  
  68. procedure Register;
  69.  
  70. implementation
  71.  
  72. {***VCL Preferences************************************************************}
  73.  
  74. {constructor -
  75.  note: panels created in reverse order}
  76. constructor TStatusPanel.Create(AOwner: TComponent);
  77. begin
  78.   inherited Create(AOwner);
  79.    Align := alBottom;            {default to bottom of form}
  80.  
  81.   {create time panel}
  82.   FTimePanel := TPanel.Create(self);
  83.   with FTimePanel do
  84.   begin
  85.     Parent := self;              {set parent to self}
  86.     width := 65;
  87.     Align := alRight;            {set alignment to right}
  88.     BevelOuter := bvLowered;     {set bevel appearances}
  89.     BevelInner := bvLowered;
  90.     Caption := 'Time';           {set caption text}
  91.     Alignment := taLeftJustify;  {left-justify caption}
  92.     ParentFont := true;          {assume the parent's font}
  93.   end;
  94.  
  95.   {create scroll-lock panel}
  96.   FScrollPanel := TPanel.Create(self);
  97.   with FScrollPanel do
  98.   begin
  99.     Parent := self;              {set parent to self}
  100.     width := 40;
  101.     Align := alRight;            {set alignment to right}
  102.     BevelOuter := bvLowered;     {set bevel appearances}
  103.     BevelInner := bvLowered;
  104.     Caption := 'Scroll';         {set caption text}
  105.     Alignment := taLeftJustify;  {left-justify caption}
  106.     ParentFont := true;          {assume the parent's font}
  107.   end;
  108.  
  109.   {create num-lock panel}
  110.   FNumPanel := TPanel.Create(self);
  111.   with FNumPanel do
  112.   begin
  113.     Parent := self;              {set parent to self}
  114.     width := 40;
  115.     Align := alRight;            {set alignment to right}
  116.     BevelOuter := bvLowered;     {set bevel appearances}
  117.     BevelInner := bvLowered;
  118.     Caption := 'Num';            {set caption text}
  119.     Alignment := taLeftJustify;  {left-justify caption}
  120.     ParentFont := true;          {assume the parent's font}
  121.   end;
  122.  
  123.   {create caps-lock panel}
  124.   FCapsPanel := TPanel.Create(self);
  125.   with FCapsPanel do
  126.   begin
  127.     Parent := self;              {set parent to self}
  128.     width := 40;
  129.     Align := alRight;            {set alignment to right}
  130.     BevelOuter := bvLowered;     {set bevel appearances}
  131.     BevelInner := bvLowered;
  132.     Caption := 'Caps';           {set caption text}
  133.     Alignment := taLeftJustify;  {left-justify caption}
  134.     ParentFont := true;          {assume the parent's font}
  135.   end;
  136.  
  137.   {create comment panel}
  138.   FStatusPanel := TPanel.Create(self);
  139.   with FStatusPanel do
  140.   begin
  141.     Parent := self;              {set parent to self}
  142.     Align := alClient;           {set alignment to client}
  143.     BevelOuter := bvLowered;     {set bevel appearances}
  144.     BevelInner := bvLowered;
  145.     Caption := 'Status Panel';   {set caption text}
  146.     Alignment := taLeftJustify;  {left-justify caption}
  147.     ParentFont := true;          {assume the parent's font}
  148.   end;
  149.  
  150. end;
  151.  
  152. {constructor - for wrapper}
  153. constructor TcwStatusBar.Create(AOwner: TComponent);
  154. begin
  155.   inherited Create(AOwner);
  156.  
  157.    {create status-panel}
  158.    Align := alBottom;                        {default to alBottom}
  159.    StatusPanel := TStatusPanel.Create(self); {create a TStatusPanel instance}
  160.    with StatusPanel do
  161.    begin
  162.      Parent := self;                         {set parent to self}
  163.      Align := alClient;                      {set alignment to client}
  164.    end;
  165.    Height := 25;
  166.  
  167.    {create TTimer}
  168.    FTimer := TTimer.create(self);
  169.    with FTimer do
  170.     begin
  171.      OnTimer := mTimer;
  172.      interval := 250;                        {update panels quarter of a second}
  173.      enabled := true;
  174.     end;
  175.  
  176.    {set application's OnHint to the custom method, used by the TTimer. This will
  177.     force the application, when a hint is encountered, to be displayed in the
  178.     panel.}
  179.    application.onHint := mTimer;
  180.  
  181.    {call timer method - this ensures that the application will open with a
  182.     status-bar that is configured and running}
  183.    mTimer(self);
  184.  
  185. end;
  186.  
  187. {destructor - for wrapper}
  188. destructor TcwStatusBar.Destroy;
  189. begin
  190.   inherited Destroy;
  191. end;
  192.  
  193. {return caption (of panel in index)}
  194. function TcwStatusBar.GetCaption(Index: Integer): string;
  195. begin
  196.   case Index of
  197.     0: result := StatusPanel.FStatusPanel.caption;
  198.     1: result := StatusPanel.FCapsPanel.caption;
  199.     2: result := StatusPanel.FNumPanel.caption;
  200.     3: result := StatusPanel.FScrollPanel.caption;
  201.     4: result := StatusPanel.FTimePanel.caption;
  202.     { Show error if any other Index was entered }
  203.     else MessageDlg('Invalid Index Value', mtWarning, [mbOk], 0);
  204.   end;
  205. end;
  206.  
  207. {set caption (of panel in index)}
  208. procedure TcwStatusBar.SetCaption(Index: Integer; Cap: string);
  209. begin
  210.   case Index of
  211.     0: StatusPanel.FStatusPanel.Caption := cap;
  212.     1: StatusPanel.FCapsPanel.Caption := cap;
  213.     2: StatusPanel.FNumPanel.caption := cap;
  214.     3: StatusPanel.FScrollPanel.caption := cap;
  215.     4: StatusPanel.FTimePanel.caption := cap;
  216.     { Show an error if any other Index was entered }
  217.     else MessageDlg('Invalid Index Value', mtWarning, [mbOk], 0);
  218.   end;
  219. end;
  220.  
  221. {register}
  222. procedure Register;
  223. begin
  224.   RegisterComponents('cw_apps', [TcwStatusBar]);
  225. end;
  226.  
  227. {***custom routines************************************************************}
  228.  
  229. {on timer, update captions}
  230. procedure TcwStatusBar.mTimer(sender: TObject);
  231. begin
  232.  
  233.  {set hint}
  234.  Captions[0] := ' '+application.hint;
  235.  
  236.  {set caps lock}
  237.  if GetKeyState(VK_CAPITAL) <> 0 then
  238.   Captions[1] := ' CAP'
  239.  else
  240.   Captions[1] := '';
  241.  
  242.  {set num lock}
  243.  if GetKeyState(VK_NUMLOCK) <> 0 then
  244.   Captions[2] := ' NUM'
  245.  else
  246.   Captions[2] := '';
  247.  
  248.  {set scroll lock}
  249.  if GetKeyState(VK_SCROLL) <> 0 then
  250.   Captions[3] := ' SCRL'
  251.  else
  252.   Captions[3] := '';
  253.  
  254.  {set time}
  255.  Captions[4] := ' '+TimeToStr(now);
  256.  
  257. end;
  258.  
  259. {}
  260. end.
  261.